BBS in a Box 11/AMUG BBS in a Box Volume XI (April 1994) (MacWizards).iso/Files/Prog/D-G/DA Skeleton 2.0.sit/DASkeleton.p

Text File | 1990-06-09 | 13.8 KB | 496 lines | [TEXT/PJMM]

{    DASkeleton (v2.0)                                                                        }
{    By: Michael J. Conrad                                                                    }
{                                                                                                }
{    This DA skeleton was written in THINK Pascal™ 3.01.                                }
{                                                                                                }
{    Intro.                                                                                        }
{    -----                                                                                        }
{    I wrote DASkeleton to aid new programmers in writing desk accessories. All        }
{    you really have to do is add in what you want your DA to do. This skeleton         }
{    takes care of almost all the normal things DAs must do.                                }
{                                                                                                }
{    DASkeleton is also good for experienced programmers who are tired of typing        }
{    in all the basics every time they write a desk accessory.                            }
{                                                                                                }
{    DA Shell Users                                                                            }
{    -------------                                                                            }
{    If you use the DA Shell that comes on your THINK Pascal™ disk, there are some    }
{    things you must change or take into consideration:                                    }
{                                                                                                }
{        1.    The formula for figuring the owned resources must be changed. For the        }
{            DA Shell, your DA's refNum must be calculated as:                            }
{                                                                                                }
{                            refNum:=Abs(dce^.dCtlRefNum)-1;                                }
{                                                                                                }
{            For the actual desk accessory, it must be calculated as:                        }
{                                                                                                }
{                            refNum:=Abs(-dce^.dCtlRefNum)-1;                            }
{                                                                                                }
{            Note that the way the instructions say to do it in the DA Shell is wrong.    }
{            The THINK Pascal™ user's manual explains it correctly.                        }
{                                                                                                }
{        2.     When handling mouse down events in the DA Shell, you must have your        }
{            DA handle it as "InContent". As a real DA, you must have it as                 }
{            "inSysWindow". You must physically change the case constants in the         }
{            doMouseDown procedure.                                                        }
{                                                                                                }
{        4.     When using the DA Shell, you must create "dummy" procedures for            }
{            RememberA4, SetUpA4, and RestoreA4. This is because only the             }
{            DRVRRuntime library contains these procedures.                                }
{                                                                                                }
{        3.    Read the instructions in the DAShell and the THINK Pascal™ users manual    }
{            for more information.                                                            }
{                                                                                                }
{    Version 2.0 Changes                                                                        }
{    -------------------                                                                        }
{                                                                                                }
{    The changes in 2.0 are really too numerous to mention. But here are a few key    }
{    changes.                                                                                    }
{                                                                                                }
{        √    Code is broken into more separate procedures.                                }
{        √    Fixed menu bug where it wouldn't go away when DA was closed.                }
{        √    Fixed reentrancy problems.                                                        }
{        √    Set the dCtlFlags manually now. This kind of goes with the one above.        }
{        √    Included a hierarchical menu.                                                    }
{                                                                                                }
{    Where Did All The Comments Go?                                                        }
{    ------------------------------                                                        }
{    I didn't add as many comments in version 2.0 as there has been in previous        }
{    versions. This is because the comments tended to "get in the way". If you're        }
{    writing a DA, you should already be fairly familiar with programming the            }
{    Macintosh™, so most of the comments aren't needed anyway.                        }
{                                                                                                }
{    Using Hierarchical Menus In DA's                                                        }
{    ---------------------------                                                            }
{    If you use the DA Shell, be sure you use the revised one. The latest one to date    }
{    and the only one which supports hierarchical menus was revised on 5/22/90 by    }
{    Dennis King (DLK). It can be found in the Symantec™ forum on CIS.                     }
{                                                                                                }
{    Watch Out!!                                                                                }
{    -----------                                                                                }
{    If you use the cdev hierDA (A.K.A. DA Menuz), you must disable it before             }
{    attempting to run your DA in the DA Shell. This is because hierDA automatically    }
{    opens a DA when it thinks one of its menus is being used. And if one of your        }
{    hierarchical menus happens to have the same id as an exhisting DA, the DA will    }
{    open suddenly on you, and may cause a system crash (it does on my machine).        }
{                                                                                                }
{    Non-THINK Pascal Users                                                                    }
{    ----------------------                                                                    }
{    You can still use this DA Skeleton, but...most other pascal compilers don't             }
{    allow the use of global data in drivers.                                                    }
{                                                                                                }
{    Mentionware                                                                                }
{    ------------                                                                                }
{    If you use this as your skeleton, all I ask for is that either in your about box        }
{    or documentation, you mention that you used DASkeleton.                            }
{                                                                                                }
{    Credits                                                                                    }
{    -------                                                                                    }
{    Thanks to Dennis King, who passed along some bugs he noticed and help me out        }
{    with the menu and bit setting problems. He is also responsible for revising the        }
{    DA Shell to watch for hierarchical menus.                                                }
{                                                                                                }
{    In Closing                                                                                    }
{    ---------                                                                                    }
{    If you find any bugs _PLEASE_ let me know so I can fix them. I would rather        }
{    fix them instead of having someone else spend hours trying to fix one of my        }
{    mistakes!                                                                                    }
{                                                                                                }
{    DASkeleton is Copyright (c) 1989-90, Michael Conrad. All Rights Reserved.        }
{    CIS: [73457,426]        GENIE: M.CONRAD1        Amer.On: MichaelC50            }

unit DASkeleton;

interface

    uses
        Globals, MiscRoutines;

{All drivers and code resources in LSP must have a function or procedure called 'main'}
    function main (theDce: DCtlPtr; iopb: ParmBlkPtr; sel: integer): OSErr;

implementation

{--------------------------------•--------------------------------}

{Our window just got uncovered, so redraw the window}
    procedure UpdateWindow;
        const
            Line1 = 'DA Skeleton';
            Line2 = 'Version 2.0';
            Line3 = 'Written in THINK Pascal™ 3.0';
            Line4 = 'Copyright (c) 1989-90';
            Line5 = 'By: Michael J. Conrad';
    begin
        SetPort(window);

        TextSize(12);
        TextFont(geneva);
        TextFace([Outline]);
        MoveTo(90, 20);
        DrawString(Line1);
        TextFace([]);
        TextFace([italic]);
        MoveTo(95, 34);
        DrawString(Line2);
        TextFace([]);
        MoveTo(38, 50);
        DrawString(Line3);

        MoveTo(5, 60);
        LineTo(255, 60);

        TextSize(9);
        MoveTo(10, 77);
        DrawString(Line4);
        MoveTo(10, 90);
        DrawString(Line5);

        DrawControls(window);
    end;

{--------------------------------•--------------------------------}

    procedure DoButton (theControl: ControlHandle);
        var
            Part: integer;
            err: integer;
            thePoint: Point;

    begin
        Part := TrackControl(theControl, thePoint, nil);
        if (Part = InButton) then
            begin
                err := CloseDriver(dce^.dCtlRefNum);
            end;
    end;

{--------------------------------•--------------------------------}

    procedure doMouseDown (thePoint: Point);
        var
            thePart: integer;
            where: integer;
            theControl: ControlHandle;

    begin
        thePart := FindWindow(thePoint, window);

        if (thePart = inContent) then
            begin
                GlobalToLocal(thePoint);
                where := FindControl(thePoint, window, theControl);
                if (theControl = theButton) then
                    DoButton(theControl);
            end;
    end;

{--------------------------------•--------------------------------}

    procedure DoKeyDown (event: EventPtr);
        var
            ch: char;

    begin
        ch := Chr(BitAnd(event^.message, CharCodeMask));
        if BitAnd(event^.modifiers, CmdKey) <> 0 then
            if event^.what <> autoKey then
                begin
                    case ch of                                {This covers the standard command keys}
                        'z', 'Z':                                 {in the Edit menu.}
                            SysBeep(1);
                        'x', 'X':
                            SysBeep(1);
                        'c', 'C':
                            SysBeep(1);
                        'v', 'V':
                            SysBeep(1);
    {Insert other command keys here}
                    end;
                end;
    end;

{--------------------------------•--------------------------------}

    procedure DoActivate (event: EventPtr);
    begin
        if BitAnd(event^.modifiers, ActiveFlag) <> 0 then
            begin
                InsertMenu(ourMenu, 0);
                InsertMenu(hierMenu, -1);
                DrawMenuBar;
            end
        else
            begin
                DeleteMenu(dce^.dCtlMenu);
                DeleteMenu(hierMID);
                DrawMenuBar;
            end;
    end;

{--------------------------------•--------------------------------}

{This routine handles the events that are passed to us via control}
    procedure doEvent (event: EventPtr);
    begin
        case event^.what of
            keyDown:
                DoKeyDown(event);
            mouseDown:
                doMouseDown(event^.where);
            UpdateEvt:
                begin
                    SetPort(window);
                    BeginUpdate(window);
                    UpdateWindow;
                    EndUpdate(window);
                end;
            ActivateEvt:
                DoActivate(event);
        end;
    end;

{--------------------------------•--------------------------------}

{Put up an about window an brag about ourselves}
    procedure DoAbout (window: WindowPtr);
        var
            AboutDlg: DialogPtr;
            savePort: GrafPtr;
            item: integer;
            Flag: Boolean;

    begin
        GetPort(savePort);
        HideWindow(window);

        AboutDlg := GetNewDialog(rslvid(ABOUTID), nil, WindowPtr(-1));
        CenterWindow(AboutDlg, True, True);
        ShowWindow(AboutDlg);
        SetPort(AboutDlg);

        Flag := True;
        while Flag do
            begin
                ModalDialog(@updateFilter, item);
                if (item = 1) then
                    Flag := False;
            end;

        DisposDialog(AboutDlg);
        ShowWindow(window);
        SetPort(savePort);
    end;

{--------------------------------•--------------------------------}

    procedure InitWindow;
    begin
    {Get our window from the resource. (a WIND resource)}
        window := GetNewWindow(rslvid(MAINWINDOW), nil, WindowPtr(-1));
        CenterWindow(window, True, False);
        SetWTitle(window, TITLE);
        ShowWindow(window);
        SetPort(window);

        WindowPeek(window)^.windowkind := dce^.dCtlRefNum;
        dce^.dCtlWindow := WindowPtr(window);

        theButton := GetNewControl(rslvid(BUTTONID), window);
    end;

{--------------------------------•--------------------------------}

    procedure InitMenus;
        var
            theID: integer;

    begin
        theID := rslvid(MENUID);
        ourMenu := GetMenu(theID);
        ourMenu^^.menuId := theID;
        dce^.dCtlMenu := theID;
        InsertMenu(ourMenu, 0);

        hierMenu := GetMenu(rslvid(HIERID));
        hierMenu^^.menuId := hierMID;
        InsertMenu(hierMenu, -1);

        DrawMenuBar;
    end;

{--------------------------------•--------------------------------}

    procedure HandleMenus (theMenu, theItem: integer);
    begin
        if (theMenu = dce^.dCtlMenu) then
            case theItem of
                1:
                    DoAbout(window);
                2:
                    SysBeep(10);
                3:
                    SysBeep(10);
                4:
                    SysBeep(10);
                otherwise
                    ;
            end;
        if (theMenu = hierMID) then
            case theItem of
                1:
                    SysBeep(1);
                2:
                    ;
                3:
                    ;
                otherwise
                    ;
            end;
        HiliteMenu(0);
    end;

{--------------------------------•--------------------------------}

{////////////  Driver Routines Are Below Here  ////////////}

{--------------------------------•--------------------------------}

{This procedure handles our open call. It puts up a window and}
{gets our menu for our DA. In addition it figures the screen size}
{and our drivers reference number.}
    procedure open (iopb: ParmBlkPtr);
    begin
        window := WindowPtr(dce^.dCtlWindow);
        if not DAOpen then
            begin
                DAOpen := True;
                screenBounds := GetScrSize;    {Get the screen size}
                InitWindow;
                InitMenus;
            end
        else
            SelectWindow(window);
    end;

{--------------------------------•--------------------------------}

{This procedure handles control calls from the dce. Such as}
{menus, and other events.}
    procedure control (iopb: ParmBlkPtr);
    begin
        window := WindowPtr(dce^.dCtlWindow);
        SetPort(window);

        case iopb^.csCode of
            accEvent:
                doEvent(Pointer(iopb^.ioMisc));
            accRun:
                begin
{*** Your DA is getting time from the system...Do whatever ***}
                end;
            accMenu:
                HandleMenus(iopb^.csParam[0], iopb^.csParam[1]);
            accUndo:
                SysBeep(1);
            accCut:
                SysBeep(1);
            accCopy:
                SysBeep(1);
            accPaste:
                SysBeep(1);
            accClear:
                SysBeep(1);
        end;
    end;

{--------------------------------•--------------------------------}

{This routine handles our close call. It takes down our window}
{and clears the menu bar. Always clean up behind yourself!!}
    procedure close (iopb: ParmBlkPtr);
    begin
        window := WindowPtr(dce^.dCtlWindow);
        if (DAOpen) then
            begin
                DeleteMenu(hierMID);
                DeleteMenu(dce^.dCtlMenu);
                DrawMenuBar;

                ReleaseResource(Handle(ourMenu));        {Just for GP}
                ReleaseResource(Handle(hierMenu));

                dce^.dCtlMenu := 0;
                ourMenu := nil;
                hierMenu := nil;

                DisposeWindow(window);
                dce^.dCtlWindow := nil;

                DAOpen := False;
            end;
    end;

{--------------------------------•--------------------------------}

    procedure prime (iopb: ParmBlkPtr);
    begin
{Only "real" drivers use this call. We don't need it in this DA}
    end;

{--------------------------------•--------------------------------}

    procedure status (iobp: ParmBlkPtr);
    begin
{Only "real" drivers use this call. We don't need it in this DA}
    end;

{--------------------------------•--------------------------------}

    function main (theDce: DCtlPtr; iopb: ParmBlkPtr; sel: integer): OSErr;
        const
            drvrOpen = 0;
            drvrPrime = 1;
            drvrControl = 2;
            drvrStatus = 3;
            drvrClose = 4;

            dCtlEnable = 2;                        {Enable/Disable control calls}
            dNeedTime = 5;                        {Give us some time from the system}
    begin
        main := 0;                                {No problems...}
        RememberA4;

        BitClr(@theDCE^.dCtlFlags, dCtlEnable);

        dce := theDce;

        case sel of
            drvrOpen:
                begin
                    if (dce^.dCtlStorage = nil) then    {For some reason, we could not get enough    }
                        begin                                {memory to run. Exit the DA. You could put}
                            SysBeep(5);                    {a dialog up stating that the DA can't run,but}
                            main := -108;                    {you can't use any globals!!}
                            Exit(main);
                        end;
                    open(iopb);                    {Call OPEN procedure}
                end;
            drvrPrime:
                prime(iopb);
            drvrControl:
                control(iopb);                    {Handle a CONTROL call for our DA}
            drvrStatus:
                status(iopb);
            drvrClose:
                close(iopb);                    {Close our DA}
        end;

        theDce^.dCtlDelay := 60;                    {Get us some time}
        BitSet(@theDCE^.dCtlFlags, dCtlEnable);    {Set our flags}
        BitSet(@theDCE^.dCtlFlags, dNeedTime);
    end;

{--------------------------------•--------------------------------}

end.